stepmain.~pas

Delphi图像盖章程序源码,供大家参考。

tmp:=GShow_title(GProOption.FileName,'.',3);
if uppercase(GShow_title(GProOption.FileName,'.',4)) = uppercase('bmp')
   then begin
          GProOption.IBmp.LoadFromFile(GProOption.FileName);
          GProOption.IJPeg:=G_BMPToJPeg(GProOption.IBmp);
        end
   else if uppercase(GShow_title(GProOption.FileName,'.',4)) = uppercase('jpg')
           then begin
                 GProOption.IJPeg.LoadFromFile(GProOption.FileName);
                 GProOption.IBmp:=G_JPegToBMP(GProOption.IJPeg);
                end;
image6.Picture.Bitmap:=GProOption.IBmp;
         end;
end;

procedure TmainF.Image6MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var M_xs,M_ys:integer;
begin
if SpeedButton10.Down
   then begin
   if ssleft in shift
   then leftup:=true
   else rightup:=true;
G_draw:=true;
Drawing:=true;
M_xs:=round(x*m_li);
M_ys:=round(y*m_li);
G_BeginPoint:=point(M_xs,M_ys);
G_endPoint:=point(M_xs,M_ys);
        end;
end;

procedure TmainF.Image6MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var M_xs,M_ys:integer;
begin
if SpeedButton10.Down
   then begin
label11.Caption:='坐标：('+inttostr(x)+','+inttostr(y)+')';
M_xs:=round(x*m_li);
M_ys:=round(y*m_li);
if G_draw then begin
T_Course.GDrawShape(image6,T_Course.DrawingTool,G_beginpoint,G_endpoint,PmNotXor,false);
G_beginpoint:=point(round(M_xs*m_li),round(M_ys*m_li));
T_Course.GDrawShape(image6,T_Course.DrawingTool,G_beginpoint,G_endpoint,PmNotXor,false);
               end;
        end;
end;

procedure TmainF.Image6MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var M_xs,M_ys:integer;
    tmp:string;
begin
if SpeedButton11.Down
   then GPoint_show(ScrollBox2,x,y,1)
   else
if SpeedButton10.Down
   then begin
M_xs:=round(x*m_li);
M_ys:=round(y*m_li);
if (G_Draw) and (leftup)
   then begin
    GM_stringpoint:=GM_stringpoint+inttostr(M_xs)+','+inttostr(M_ys)+';';
    G_PointSum:=G_PointSum+1;
        end;

if (G_Draw) and rightup then begin
GM_stringpoint:=GM_stringpoint+inttostr(M_xs)+','+inttostr(M_ys)+';';
G_beginpoint:=point(M_xs,M_ys);
tmp:=GShow_title(GM_stringpoint,';',3);
///////////////////////////////////////////////////////////////////////////
M_PHO.IAddpoint_top:=Point(strtoint(Gshow_title(tmp,',',3)),strtoint(GShow_title(tmp,',',4)));
M_PHO.IAddpoint_bott:=G_endpoint;

M_address[listbox2.ItemIndex].IAddpoint_bott:=M_PHO.IAddpoint_bott;
M_address[listbox2.ItemIndex].IAddpoint_Top:=M_PHO.IAddpoint_Top;

label11.Caption:='插入位置：('+inttostr(M_PHO.IAddpoint_top.X)+','+inttostr(M_PHO.IAddpoint_top.X)+')'+'/'+
                           '('+inttostr(M_PHO.IAddpoint_bott.X)+','+inttostr(M_PHO.IAddpoint_bott.X)+')';

M_PHO:=M_address[listbox2.ItemIndex];
case M_address[listbox2.ItemIndex].Itype of
0:begin
  end;
1,3:MDraw_(image6,RadioGroup3.ItemIndex,M_PHO);
2:begin
  end;
//3:begin
//  end;
end;//case
///////////////////////////////////////////////////////////////////////////
T_Course.GDrawShape_(image6,T_Course.DrawingTool,GM_stringpoint,PmNotXor);
T_Course.GDrawShape(image6,T_Course.DrawingTool,M_PHO.IAddpoint_top,M_PHO.IAddpoint_bott,PmNotXor,false);

G_Draw:=false;
G_PointSum:=0;
leftup:=false;
rightup:=false;

m_li:=1;
DrawingTool:=dtRectangle;
GM_stringpoint:='';
image6.Canvas.Brush.Style:=bsClear;
image6.Canvas.Pen.Style:=psSolid;
image6.Canvas.Pen.Width:=1;
                             end;

end;


end;

procedure TmainF.SpeedButton10Click(Sender: TObject);
begin
m_li:=1;
DrawingTool:=dtRectangle;
GM_stringpoint:='';
end;

procedure TmainF.ListBox3MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var tmp:string;
begin
if ListBox3.ItemIndex >-1
  then begin
GProOption.IJPeg.Free;
GProOption.IBmp.Free;
GProOption.IJPeg := TJPegImage.Create;
GProOption.IBmp := TBitmap.Create;

GProOption.FileName:=ShellTreeView1.Path+'\'+ListBox3.Items[ListBox3.ItemIndex];
label11.Caption:=GProOption.FileName;

tmp:=GShow_title(GProOption.FileName,'.',3);
if uppercase(GShow_title(GProOption.FileName,'.',4)) = uppercase('bmp')
   then begin
          GProOption.IBmp.LoadFromFile(GProOption.FileName);
          GProOption.IJPeg:=G_BMPToJPeg(GProOption.IBmp);
        end
   else if uppercase(GShow_title(GProOption.FileName,'.',4)) = uppercase('jpg')
           then begin
                 GProOption.IJPeg.LoadFromFile(GProOption.FileName);
                 GProOption.IBmp:=G_JPegToBMP(GProOption.IJPeg);
                end;
image7.Picture.Bitmap:=GProOption.IBmp;
         end;
         
MDraw_(image7,M_address[listbox3.ItemIndex].Itype,M_address[listbox3.ItemIndex]);
GPoint_show(ScrollBox3,M_address[listbox3.ItemIndex].IAddpoint_top.X,M_address[listbox3.ItemIndex].IAddpoint_top.Y,1);
end;

procedure TmainF.ComboBox4Change(Sender: TObject);
begin
M_PHO.mIstrFontName:=combobox4.Items[combobox4.Itemindex];
 M_address[ListBox4.ItemIndex].mIstrFontName:=combobox4.Items[combobox4.Itemindex];
edit7.Font.Name:=M_PHO.mIstrFontName;
end;

procedure TmainF.Edit6Change(Sender: TObject);
begin
M_PHO.mIstrFontSize:=strtoint(edit6.text);
 M_address[ListBox4.ItemIndex].mIstrFontSize:=strtoint(edit6.text);
edit7.Font.Size:=M_PHO.mIstrFontSize;
end;

procedure TmainF.ComboBox5Change(Sender: TObject);
begin
M_PHO.mIstrFontStyle:=strtoFontStyle(combobox5.Items[combobox5.Itemindex]);
M_address[ListBox4.ItemIndex].mIstrFontStyle:=strtoFontStyle(combobox5.Items[combobox5.Itemindex]);
case combobox5.Itemindex of
0:edit7.Font.Style:=[fsBold];
1:edit7.Font.Style:=[fsitalic];
2:edit7.Font.Style:=[fsunderline];
3:edit7.Font.Style:=[fsstrikeout];
end;

end;

procedure TmainF.Image5MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
if ColorDialog1.Execute
   then begin
          M_Pho.mIstrFontColor:=ColorDialog1.Color;
           M_address[ListBox4.ItemIndex].mIstrFontColor:=ColorDialog1.Color;
          image5.Canvas.Brush.Color:=M_Pho.mIstrFontColor;
          image5.Canvas.Rectangle(0,0,image5.Width,image5.Height);
          edit7.Font.Color:=M_Pho.mIstrFontColor;
        end;

end;

procedure TmainF.ColorGrid2MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
M_Pho.mIstrFontColor:=ColorGrid2.ForegroundColor;
  M_address[ListBox4.ItemIndex].mIstrFontColor:=ColorGrid2.ForegroundColor;
M_Pho.mIstrBrushColor:=ColorGrid2.BackgroundColor;
  M_address[ListBox4.ItemIndex].mIstrBrushColor:=ColorGrid2.BackgroundColor;

edit7.Color:=M_Pho.mIstrBrushColor;
      image5.Canvas.Brush.Color:=M_address[ListBox4.ItemIndex].mIstrFontColor;
      image5.Canvas.Rectangle(0,0,image5.Width,image5.Height);
      edit7.Font.Color:=M_address[ListBox4.ItemIndex].mIstrFontColor;
end;

procedure TmainF.ListBox4MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
//CreateType(li:integer);
RadioGroup3.ItemIndex:=M_address[ListBox4.ItemIndex].Itype;

case RadioGroup3.ItemIndex of
0:begin
    edit2.Text:=M_address[ListBox4.ItemIndex].Ifilename;
  end;
1:begin
combobox1.Items.Clear;
    edit3.Text:=M_address[ListBox4.ItemIndex].Ifilename;
    GListStrings(edit3.Text,combobox1.Items);
    if edit3.Text = ''
       then combobox1.Clear
       else combobox1.ItemIndex:=M_address[ListBox4.ItemIndex].IvfdID-1;

  end;
2:begin
    //      mIstrBrushStyle
    //      mIstrBrushColor
    edit4.Text:=M_address[ListBox4.ItemIndex].Istr;
    edit4.Font.Name:=M_address[ListBox4.ItemIndex].mIstrFontName;
    edit4.Font.Size:=M_address[ListBox4.ItemIndex].mIstrFontSize;
    edit4.Font.Color:=M_address[ListBox4.ItemIndex].mIstrFontColor;
    //      mIstrFontStyle:TFontStyle;
  end;//2
3:begin
    edit7.Font.Name:=M_address[ListBox4.ItemIndex].mIstrFontName;
    edit7.Font.Size:=M_address[ListBox4.ItemIndex].mIstrFontSize;
    edit7.Font.Color:=M_address[ListBox4.ItemIndex].mIstrFontColor;
    //       mIstrFontStyle:TFontStyle;
    edit7.Text:=M_address[ListBox4.ItemIndex].mIdateformat;
    case M_address[ListBox4.ItemIndex].mIdateType of
    0:CheckBox1.Checked:=true;    
    1:CheckBox1.Checked:=false;
    end;//case
  end;//3
end;//case
end;

procedure TmainF.Image7MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
GPoint_show(ScrollBox3,x,y,1);
end;

procedure TmainF.Image7MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
label11.Caption:='添加后文件预览';
end;

procedure TmainF.SpeedButton10MouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
label11.Caption:='选择绘制位置';
end;

procedure TmainF.SpeedButton9MouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
label11.Caption:='选择SPR矢量标准文件文件';
end;

procedure TmainF.Image9MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
about.show
end;

procedure TmainF.Image100MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
showmessage('本程序所有技术服务由程序传播人(特许除外)负责.'+#13+
            '  基本技术支持:[e-mail]'+#13+
            'SPR Army Of China @ All Rights Reserved.');
end;

procedure TmainF.TrackBar1Change(Sender: TObject);
var i:integer;
begin
label11.Caption:='图像压缩比'+inttostr(TrackBar1.Position);
for i:=0 to ListBox4.Items.Count-1 do
   M_address[i].SIjpgzip:=TrackBar1.Position;
end;

procedure TmainF.RadioGroup4Click(Sender: TObject);
begin
  case RadioGroup4.ItemIndex of
    0:begin
        TrackBar1.Enabled:=false;
        label11.Caption:='保存为bmp图片';
      end;
    1:begin
        TrackBar1.Enabled:=true;
        label11.Caption:='保存为jpg图片';
      end;

  end;//case
end;

procedure TmainF.CheckBox5Click(Sender: TObject);
var i:integer;
begin
if CheckBox5.Checked
   then begin
         Edit8.Enabled:=true;
         for i:=0 to listbox4.Items.Count-1 do
            M_address[i].SIFileSuf:=edit8.Text;
        end
   else Edit8.Enabled:=false;
end;

procedure TmainF.Edit8KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var i:integer;
begin
case key of
VK_return:begin
          for i:=0 to listbox4.Items.Count-1 do
            M_address[i].SIFileSuf:=trim(edit8.Text);
          label11.Caption:='文件名添加后缀'+trim(edit8.Text);
          end;
end;//case
end;

procedure TmainF.Edit8MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
label11.Caption:='修改文件名后缀，这样做可以避免覆盖原有文件';
end;

procedure TmainF.DateTimePicker1Change(Sender: TObject);
begin
M_PHO.mIdatestr:=DateTimePicker1.Date;
end;

procedure TmainF.ComboBox6Change(Sender: TObject);
var i:integer;
begin
try
for i:=0 to ListBox4.Items.Count-1 do begin
  if uppercase(copy((ListBox4.Items[i]),1,1)) <> uppercase('P')
     then label11.caption:=ListBox4.Items[i]+'--文件名不符合转换标准，没有转换'
     else case ComboBox6.ItemIndex of
          0:M_address[i].mIdatestr:=strtodate(Olympus_350(Gshow_title(datetostr(DateTimePicker1.date),'-',3),ListBox4.Items[i],'-'));
          end;//case
showmessage(datetostr(M_address[i].mIdatestr));
                                      end;
except end;
label11.caption:='转换完毕';
end;

procedure TmainF.Button4Click(Sender: TObject);
begin
if SaveDialog1.Execute
   then begin
M_Pho:=M_address[combobox7.itemindex];
   GSave_PHO(SaveDialog1.FileName);
        end;
end;

procedure TmainF.Button6Click(Sender: TObject);
var i:integer;
begin
for i:=0 to CheckListBox1.Items.Count-1 do
    CheckListBox1.Checked[i]:=false;
end;

procedure TmainF.CheckBox7Click(Sender: TObject);
begin
if checkbox7.Checked
   then GProOption.AllOption:=checkbox7.Checked
   else GProOption.AllOption:=checkbox7.Checked
end;

end.