TPen e Canvas

di il
1 risposte

TPen e Canvas

Ho un problema, se devo stampare delle linee mi capita che anche se e' selezionata la proprietà diversa da psSolid nella penna, questa a seconda della risoluzione della stampa mi stampi sempre con questo stile.

Cercando su internet ho trovato una soluzione che ho modificato ed è quasi a posto, manca solo due cose.

- lo stile psClear non riesco a farlo ( al limite non faccio la stampa anche se come soluzione non è il massimo )

- la distruzione della penna non so se è corretta fatta in questo modo ( prima uso selectobject, poi delete object ). Non vorrei che non serva perchè la funzione SetHandle mi sembra che chiami un gestore di risorse che liberi già la memoria ( non sono al momento sicuro ).

Segue Codice, grazie

Procedure TAlControl.InitPen(Cnv:TCanvas);
var LogBrush : tLogBrush;
    Stile : array[0..5] of integer;
    hPenOld,
    Num,
    Spes : Integer;

begin
(*
psSolid	The pen draws a solid line.
psDash	The pen draws a line made up of a series of dashes.
psDot	The pen draws a line made up of a series of dots.
psDashDot	The pen draws a line made up of alternating dashes and dots.
psDashDotDot	The pen draws a line made up of a series of dash-dot-dot combinations.
psClear	The pen draws lines made up no visible marks.
psInsideFrame	The pen draws lines within the frame of closed shapes that specify a bounding rectangle.
*)
  Spes := Cnv.Pen.Width;

  if (Cnv.Pen.Style=psDash) Then
  Begin
    Num := 2;
    Stile[0]:=Spes*12;
    Stile[1]:=Spes*6;
  End
  Else if (Cnv.Pen.Style=psDashDot) Then
  Begin
    Num := 4;
    Stile[0]:=Spes*8;
    Stile[1]:=Spes*4;
    Stile[2]:=Spes*2;
    Stile[3]:=Spes*4;
  End
  Else if (Cnv.Pen.Style=psDashDotDot) Then
  Begin
    Num := 6;
    Stile[0]:=Spes*8;
    Stile[1]:=Spes*4;
    Stile[2]:=Spes*2;
    Stile[3]:=Spes*4;
    Stile[4]:=Spes*2;
    Stile[5]:=Spes*4;
  End
  Else if (Cnv.Pen.Style=psDot) Then
  Begin
    Num := 3;
    Stile[0]:=Spes*2;
    Stile[1]:=Spes*2;
    Stile[2]:=Spes*2;
  End
  Else if (Cnv.Pen.Style=psClear) Then
  Begin
    Num := 2;
    Stile[0]:=Spes*0;
    Stile[1]:=Spes*0;
  End
  Else // Stile solido
  Begin
    Num := 1;
    Stile[0]:=Spes*1;
  End;

  LogBrush.lbStyle := BS_Solid;
  LogBrush.lbColor := cnv.Pen.Color;
  LogBrush.lbHatch := 0;

  hPenOld := SelectObject(Cnv.Handle, Cnv.Pen.Handle);
  DeleteObject(hPenOld);
  Cnv.Pen.Handle:=ExtCreatePen(PS_GEOMETRIC or PS_USERSTYLE, Spes, LogBrush, Num, @Stile);
  //Cnv.Pen.Handle:=ExtCreatePen(PS_DASHDOT or PS_Stile, w, LogBrush, Num, @Stile);
End;

1 Risposte

  • Re: TPen e Canvas

    Risolto, in effetti il problema si presenta solo quando le linee non sono continue, quindi un if che mi fa questo controllo.
    Se la linea è continua o trasparente uso la penna tradizionale, altrimenti
    [CODE] if (Cnv.Pen.Style=psClear)or(Cnv.Pen.Style=psSolid)or(Cnv.Pen.Style=psInsideFrame) Then Begin End Else Begin if (Cnv.Pen.Style=psDash) Then Begin Num := 2; Stile[0]:=Spes*12; Stile[1]:=Spes*6; End ............ LogBrush.lbStyle := BS_Solid; LogBrush.lbColor := cnv.Pen.Color; LogBrush.lbHatch := 0; hPenOld := SelectObject(Cnv.Handle, Cnv.Pen.Handle); DeleteObject(hPenOld); Cnv.Pen.Handle:=ExtCreatePen(PS_GEOMETRIC or PS_USERSTYLE, Spes, LogBrush, Num, @Stile); End;
Devi accedere o registrarti per scrivere nel forum
1 risposte