2009年开发的一个纺织CAD工具
用于织机格式的转换的。 织布机有ip，带了ftp服务，先发cad文件到ftp上，再socket 发命令。
处理的文件
数据说明
type
CopyBitRec = record
from_begin: integer;
from_end: integer;
to_begin: integer;
end;
PYKDefine = ^TYKDefine;
TYKDefine = record
YKFileName: string; // 样卡文件名称
YKName: integer; // 织机针数 1200、2400
YKDesc: string; // 样卡 说明
YKTotalWidth: integer; // 一行总宽度
YKShuttle1: integer; // 梭箱针1
YKShuttle2: integer; // 梭箱针2
YKShuttle3: integer; // 梭箱针3
YKShuttle4: integer; // 梭箱针4
YKShuttle5: integer; // 梭箱针5
YKShuttle6: integer; // 梭箱针6
YKShuttle7: integer; // 梭箱针7
YKShuttle8: integer; // 梭箱针8
YKRegulator1: integer; // 停撬针1
YKRegulator2: integer; // 停撬针1
YkLeftSelvedgeStart: integer; // 左边 布边开始（辅助针）
YkLeftSelvedgeEnd: integer; // 左边 布边结束（辅助针）
YkDrawingStart: integer; // 正身 开始
YkDrawingEnd: integer; // 正身 结束
YkRightSelvedgeStart: integer; // 右边 布边开始（辅助针）
YkRightSelvedgeEnd: integer; // 右边 布边结束（辅助针）
end;
不同格式的转换
function EpToEP(SourceYK: TYKDefine; SourceEP: string;
TargeYK: TYKDefine; TargeEP: string): Boolean;
var
tmprec: array of CopyBitRec;
i: integer;
ms: TMemoryStream;
body_count: integer;
body_with: integer;
begin
Result := false;
if not FileExists(SourceEP) then
Exit;
body_count := checkbody_count(SourceEP, SourceYK);
body_with := (SourceYK.YkDrawingEnd - SourceYK.YkDrawingStart + 1) div body_count;
if (TargeYK.YkDrawingEnd - TargeYK.YkDrawingStart + 1) mod body_with <> 0 then
begin
raise Exception.Create('不能转换，原因：目标格式的正文宽度(' + IntToStr(TargeYK.YkDrawingEnd - TargeYK.YkDrawingStart + 1) + ')不是原文件的最小图宽(' + IntToStr(body_with) + ')的倍数.');
end;
///
setlength(tmprec, 255);
ms := TMemoryStream.Create;
try
i := YKDefine2CopyBitRec(SourceYK, TargeYK, tmprec);
setlength(tmprec, i);
ms.LoadFromFile(SourceEP);
Result := ep_to_ep(ms, TargeEP, TargeYK.YKTotalWidth, tmprec);
except;
end;
FreeAndNil(ms);
setlength(tmprec, 0);
end;
EP文件处理的全部代码
unit U_epfile_function;
interface
uses SysUtils, Classes, graphics, math;
type
CopyBitRec = record
from_begin: integer;
from_end: integer;
to_begin: integer;
end;
PYKDefine = ^TYKDefine;
TYKDefine = record
YKFileName: string; // 样卡文件名称
YKName: integer; // 织机针数 1200、2400
YKDesc: string; // 样卡 说明
YKTotalWidth: integer; // 一行总宽度
YKShuttle1: integer; // 梭箱针1
YKShuttle2: integer; // 梭箱针2
YKShuttle3: integer; // 梭箱针3
YKShuttle4: integer; // 梭箱针4
YKShuttle5: integer; // 梭箱针5
YKShuttle6: integer; // 梭箱针6
YKShuttle7: integer; // 梭箱针7
YKShuttle8: integer; // 梭箱针8
YKRegulator1: integer; // 停撬针1
YKRegulator2: integer; // 停撬针1
YkLeftSelvedgeStart: integer; // 左边 布边开始（辅助针）
YkLeftSelvedgeEnd: integer; // 左边 布边结束（辅助针）
YkDrawingStart: integer; // 正身 开始
YkDrawingEnd: integer; // 正身 结束
YkRightSelvedgeStart: integer; // 右边 布边开始（辅助针）
YkRightSelvedgeEnd: integer; // 右边 布边结束（辅助针）
end;
// <=0 表示没有
function EpToEP(SourceYK: TYKDefine; SourceEP: string;
TargeYK: TYKDefine; TargeEP: string): Boolean;
function EpToBmp(fn_ep, fn_bmp: string): Boolean;
function EpToBmp_bmp(fn: string; bmp: TBitmap): Boolean;
function EpToBmp_ms(ms: TMemoryStream; bmp: TBitmap): Boolean;
//
function t1200_to_t2400(fn1, fn2: string): boolean;
function t1200_to_z1200(fn1, fn2: string): boolean;
function t1200_to_z2400(fn1, fn2: string): boolean;
function ep_to_ep(ms: TMemoryStream; fn: string; width_to: integer; CopyBitRecList: array of CopyBitRec): boolean;
function checkbody_count(fn: string; YKDefine: TYKDefine): integer;
function checkbody_width(fn: string; YKDefine: TYKDefine): integer;
function getYKDefine(v: string): TYKDefine;
var
YKDefine_t_1200: TYKDefine;
YKDefine_t_2400: TYKDefine;
YKDefine_t_960: TYKDefine;
YKDefine_z_1200: TYKDefine;
YKDefine_z_2400: TYKDefine;
function campareBMP_2(bmp1, bmp2, bmp: TBitmap; var count: integer): boolean;
procedure bufftobits(buff: Pointer; bitcount: integer; var bits: array of boolean);
procedure bufftobits2(buff: Pointer; bitcount: integer; var bits: array of boolean);
implementation
uses ComObj;
var
BitTable: array[0..7] of Byte;
BitTable_no: array[0..7] of Byte;
BitTable_down: array[0..255] of byte;
ep_width_inc: integer = 32;
procedure inittest;
begin
{
样卡文件 梭箱针 停撬针 边丝（辅助针） 正身 边丝（辅助针）
开始 结束 数量 开始 结束 数量 开始 结束 数量
涤丝 2400 2400.yk 1 2 3 4 5 6 7 8 9 10 17 112 96 113 2512 2400 1
1200 xu1200.yk 1 2 3 4 5 6 7 8 9 10 17 104 88 113 1312 1200 1
960 xu960.yk 1 2 3 4 5 6 7 8 9 10 17 104 88 113 1072 960 1584
真丝 2400 仟代2720.yk 1 2 3 4 5 6 7 8 9 33 80 48 81 2480 2400 2481 2528 48
1200 仟代1376.yk 1 2 3 4 5 6 7 8 9 57 104 48 105 1304 1200 1305 1352 48
}
with YKDefine_t_960 do
begin
{
样卡文件 梭箱针 停撬针 边丝（辅助针） 正身 边丝（辅助针）
开始 结束 数量 开始 结束 数量 开始 结束 数量
涤丝 960 xu960.yk 1 2 3 4 5 6 7 8 9 10 17 104 88 113 1072 960 1584
}
YKName := 960;
YKTotalWidth := 1584;
YKShuttle1 := 1; // 梭箱针1
YKShuttle2 := 2; // 梭箱针2
YKShuttle3 := 3; // 梭箱针3
YKShuttle4 := 4; // 梭箱针4
YKShuttle5 := 5; // 梭箱针5
YKShuttle6 := 6; // 梭箱针6
YKShuttle7 := 7; // 梭箱针7
YKShuttle8 := 8; // 梭箱针8
YKRegulator1 := 9; // 停撬针1
YKRegulator2 := 10; // 停撬针1
YkLeftSelvedgeStart := 17; // 左边 布边开始（辅助针）
YkLeftSelvedgeEnd := 104; // 左边 布边结束（辅助针）
YkDrawingStart := 113; // 正身 开始
YkDrawingEnd := 1072; // 正身 结束
YkRightSelvedgeStart := 0; // 右边 布边开始（辅助针）
YkRightSelvedgeEnd := 0; // 右边 布边结束（辅助针）
end;
with YKDefine_t_1200 do
begin
{
样卡文件 梭箱针 停撬针 边丝（辅助针） 正身 边丝（辅助针）
开始 结束 数量 开始 结束 数量 开始 结束 数量
涤丝 1200 xu1200.yk 1 2 3 4 5 6 7 8 9 10 17 104 88 113 1312 1200 1
}
YKName := 1200;
YKTotalWidth := 1584;
YKShuttle1 := 1; // 梭箱针1
YKShuttle2 := 2; // 梭箱针2
YKShuttle3 := 3; // 梭箱针3
YKShuttle4 := 4; // 梭箱针4
YKShuttle5 := 5; // 梭箱针5
YKShuttle6 := 6; // 梭箱针6
YKShuttle7 := 7; // 梭箱针7
YKShuttle8 := 8; // 梭箱针8
YKRegulator1 := 9; // 停撬针1
YKRegulator2 := 10; // 停撬针1
YkLeftSelvedgeStart := 17; // 左边 布边开始（辅助针）
YkLeftSelvedgeEnd := 104; // 左边 布边结束（辅助针）
YkDrawingStart := 113; // 正身 开始
YkDrawingEnd := 1312; // 正身 结束
YkRightSelvedgeStart := 0; // 右边 布边开始（辅助针）
YkRightSelvedgeEnd := 0; // 右边 布边结束（辅助针）
end;
with YKDefine_t_2400 do
begin
{
样卡文件 梭箱针 停撬针 边丝（辅助针） 正身 边丝（辅助针）
开始 结束 数量 开始 结束 数量 开始 结束 数量
涤丝 2400 2400.yk 1 2 3 4 5 6 7 8 9 10 17 112 96 113 2512 2400 1
}
YKName := 2400;
YKTotalWidth := 3168;
YKShuttle1 := 1; // 梭箱针1
YKShuttle2 := 2; // 梭箱针2
YKShuttle3 := 3; // 梭箱针3
YKShuttle4 := 4; // 梭箱针4
YKShuttle5 := 5; // 梭箱针5
YKShuttle6 := 6; // 梭箱针6
YKShuttle7 := 7; // 梭箱针7
YKShuttle8 := 8; // 梭箱针8
YKRegulator1 := 9; // 停撬针1
YKRegulator2 := 10; // 停撬针1
YkLeftSelvedgeStart := 17; // 左边 布边开始（辅助针）
YkLeftSelvedgeEnd := 112; // 左边 布边结束（辅助针）
YkDrawingStart := 113; // 正身 开始
YkDrawingEnd := 2512; // 正身 结束
YkRightSelvedgeStart := 0; // 右边 布边开始（辅助针）
YkRightSelvedgeEnd := 0; // 右边 布边结束（辅助针）
end;
with YKDefine_z_1200 do
begin
{
样卡文件 梭箱针 停撬针 边丝（辅助针） 正身 边丝（辅助针）
开始 结束 数量 开始 结束 数量 开始 结束 数量
真丝 1200 仟代1376.yk 1 2 3 4 5 6 7 8 9 57 104 48 105 1304 1200 1305 1352 48
}
YKName := 2400;
YKTotalWidth := 1376;
YKShuttle1 := 1; // 梭箱针1
YKShuttle2 := 2; // 梭箱针2
YKShuttle3 := 3; // 梭箱针3
YKShuttle4 := 4; // 梭箱针4
YKShuttle5 := 5; // 梭箱针5
YKShuttle6 := 6; // 梭箱针6
YKShuttle7 := 7; // 梭箱针7
YKShuttle8 := 8; // 梭箱针8
YKRegulator1 := 9; // 停撬针1
YKRegulator2 := 0; //
YkLeftSelvedgeStart := 57; // 左边 布边开始（辅助针）
YkLeftSelvedgeEnd := 104; // 左边 布边结束（辅助针）
YkDrawingStart := 105; // 正身 开始
YkDrawingEnd := 1304; // 正身 结束
YkRightSelvedgeStart := 1305; // 右边 布边开始（辅助针）
YkRightSelvedgeEnd := 1352; // 右边 布边结束（辅助针）
end;
with YKDefine_z_2400 do
begin
{
样卡文件 梭箱针 停撬针 边丝（辅助针） 正身 边丝（辅助针）
开始 结束 数量 开始 结束 数量 开始 结束 数量
真丝 2400 仟代2720.yk 1 2 3 4 5 6 7 8 9 33 80 48 81 2480 2400 2481 2528 48
}
YKName := 2400;
YKTotalWidth := 2720;
YKShuttle1 := 1; // 梭箱针1
YKShuttle2 := 2; // 梭箱针2
YKShuttle3 := 3; // 梭箱针3
YKShuttle4 := 4; // 梭箱针4
YKShuttle5 := 5; // 梭箱针5
YKShuttle6 := 6; // 梭箱针6
YKShuttle7 := 7; // 梭箱针7
YKShuttle8 := 8; // 梭箱针8
YKRegulator1 := 9; // 停撬针1
YKRegulator2 := 0; //
YkLeftSelvedgeStart := 33; // 左边 布边开始（辅助针）
YkLeftSelvedgeEnd := 80; // 左边 布边结束（辅助针）
YkDrawingStart := 81; // 正身 开始
YkDrawingEnd := 2480; // 正身 结束
YkRightSelvedgeStart := 2481; // 右边 布边开始（辅助针）
YkRightSelvedgeEnd := 2528; // 右边 布边结束（辅助针）
end;
end;
function getYKDefine(v: string): TYKDefine;
var
str_v: string;
begin
Result := YKDefine_t_1200;
str_v := StringReplace(v, ' ', '', [rfReplaceAll]);
if sametext(str_v, '涤丝1200') then
begin
Result := YKDefine_t_1200;
exit;
end;
if sametext(str_v, '涤丝960') then
begin
Result := YKDefine_t_960;
exit;
end;
if sametext(str_v, '涤丝2400') then
begin
Result := YKDefine_t_2400;
exit;
end;
if sametext(str_v, '真丝1200') then
begin
Result := YKDefine_z_1200;
exit;
end;
if sametext(str_v, '真丝2400') then
begin
Result := YKDefine_z_2400;
exit;
end;
end;
function campareBMP_2(bmp1, bmp2, bmp: TBitmap; var count: integer): boolean;
var
w1, h1: integer;
w2, h2: integer;
w, h: integer;
x, y: integer;
pline1: PByte;
pline2: PByte;
pline: PByte;
bitcount: integer;
bits1: array of boolean;
bits2: array of boolean;
begin
count := 0;
result := false;
if bmp1.PixelFormat <> pf1bit then
exit;
if bmp2.PixelFormat <> pf1bit then
exit;
w1 := bmp1.Width;
h1 := bmp1.Height;
w2 := bmp2.Width;
h2 := bmp2.Height;
w := max(w1, w2);
H := max(h1, h2);
bmp.PixelFormat := pf8bit;
bmp.Width := w;
bmp.Height := h;
bmp.Canvas.Brush.Color := clBlue;
bmp.Canvas.FillRect(Rect(0, 0, w, h));
bitcount := Min(w1, w2);
setlength(bits1, bitcount);
setlength(bits2, bitcount);
count := w * h;
try
for y := 0 to min(h1, h2) - 1 do
begin
pline := bmp.ScanLine[y];
pline1 := bmp1.ScanLine[y];
pline2 := bmp2.ScanLine[y];
bufftobits2(pline1, bitcount, bits1);
bufftobits2(pline2, bitcount, bits2);
for x := 0 to bitcount - 1 do
begin
if bits1[x] = bits2[x] then
begin
if bits1[x] then
pline^ := $FF
else
pline^ := 0;
dec(count);
end
else
begin
pline^ := $F9;
end;
inc(pline);
end;
end;
except
end;
setlength(bits1, bitcount);
setlength(bits2, bitcount);
end;
procedure cleartest;
begin
end;
function YKDefine2CopyBitRec(YKDefine1, YKDefine2: TYKDefine; var v: array of CopyBitRec): integer;
var
idx: integer;
procedure addRec(from_begin, from_end, to_begin: integer);
begin
if from_begin <= 0 then
exit;
if from_end <= 0 then
exit;
if to_begin <= 0 then
exit;
inc(idx);
v[idx].from_begin := from_begin - 1;
v[idx].from_end := from_end - 1;
v[idx].to_begin := to_begin - 1;
end;
procedure addRec2(from_begin, from_end, to_begin, to_end: integer);
var
from_i, to_i, w: integer;
begin
if from_begin <= 0 then
exit;
if from_end <= 0 then
exit;
if to_begin <= 0 then
exit;
if to_end <= 0 then
exit;
from_i := from_begin;
to_i := to_begin;
while to_i <= to_end do
begin
w := min(from_end - from_i, to_end - to_i);
if w < 0 then
Break;
addRec(from_begin, from_begin + w, to_i);
inc(to_i, w + 1);
inc(from_i, w + 1);
if from_i > from_end then
from_i := from_begin;
end;
end;
begin
Result := 0;
idx := -1;
addRec(YKDefine1.YKShuttle1, YKDefine1.YKShuttle1, YKDefine2.YKShuttle1); // 梭箱针1
addRec(YKDefine1.YKShuttle2, YKDefine1.YKShuttle2, YKDefine2.YKShuttle2); // 梭箱针2
addRec(YKDefine1.YKShuttle3, YKDefine1.YKShuttle3, YKDefine2.YKShuttle3); // 梭箱针3
addRec(YKDefine1.YKShuttle4, YKDefine1.YKShuttle4, YKDefine2.YKShuttle4); // 梭箱针4
addRec(YKDefine1.YKShuttle5, YKDefine1.YKShuttle5, YKDefine2.YKShuttle5); // 梭箱针5
addRec(YKDefine1.YKShuttle6, YKDefine1.YKShuttle6, YKDefine2.YKShuttle6); // 梭箱针6
addRec(YKDefine1.YKShuttle7, YKDefine1.YKShuttle7, YKDefine2.YKShuttle7); // 梭箱针7
addRec(YKDefine1.YKShuttle8, YKDefine1.YKShuttle8, YKDefine2.YKShuttle8); // 梭箱针8
addRec(YKDefine1.YKRegulator1, YKDefine1.YKRegulator1, YKDefine2.YKRegulator1); // 梭箱针8
addRec(YKDefine1.YKRegulator2, YKDefine1.YKRegulator2, YKDefine2.YKRegulator2); // 梭箱针8
addRec2(
YKDefine1.YkLeftSelvedgeStart, YKDefine1.YkLeftSelvedgeEnd,
YKDefine2.YkLeftSelvedgeStart, YKDefine2.YkLeftSelvedgeEnd); // 左边 布边（辅助针）
addRec2(
YKDefine1.YkDrawingStart, YKDefine1.YkDrawingEnd,
YKDefine2.YkDrawingStart, YKDefine2.YkDrawingEnd); // 正身
if YKDefine1.YkRightSelvedgeStart <= 0 then // 如果 右边布边 没有 就取 左边的
begin
addRec2(
YKDefine1.YkLeftSelvedgeStart, YKDefine1.YkLeftSelvedgeEnd,
YKDefine2.YkRightSelvedgeStart, YKDefine2.YkRightSelvedgeEnd); // 右边 布边
end
else
begin
addRec2(
YKDefine1.YkRightSelvedgeStart, YKDefine1.YkRightSelvedgeEnd,
YKDefine2.YkRightSelvedgeStart, YKDefine2.YkRightSelvedgeEnd); // 右边 布边
end;
Result := idx + 1;
end;
function getByteCount(v: integer): integer;
begin
result := (v - 1) div 8 + 1; //字节数
result := ((result - 1) div 4 + 1) * 4; //2字节对齐
end;
procedure initBitTable;
var
i, v, k: integer;
b: Byte;
bits: array[0..7] of Boolean;
begin
v := 1;
for i := 0 to high(BitTable) do
begin
BitTable[i] := v;
BitTable_no[i] := not v;
v := v * 2;
end;
for i := 0 to 255 do
begin
b := i;
for k := 0 to 7 do
bits[7 - k] := (b and BitTable[k]) > 0;
b := 0;
for k := 0 to 7 do
if bits[k] then
b := b or BitTable[k];
BitTable_down[i] := b;
end;
end;
function ep_height(ms: TMemoryStream): Word;
begin
ms.Seek($03, soBeginning);
ms.Read(Result, 2);
end;
function ep_width(ms: TMemoryStream): Word;
begin
ms.Seek($20, soBeginning);
ms.Read(Result, 2);
Result := Result + ep_width_inc;
end;
procedure ep_width_set(ms: TMemoryStream; v: Word);
var
w: Word;
begin
ms.Seek($20, soBeginning);
w := v - ep_width_inc;
ms.Write(w, 2);
end;
function ep_DataPos(ms: TMemoryStream): Word;
begin
Result := $22;
{
ms.Seek($22, soBeginning);
ms.Read(Result, 2); }
end;
procedure bufftobits(buff: Pointer; bitcount: integer; var bits: array of boolean);
var
i, idx, k: Integer;
bytecount: Integer;
p: PByte;
b: Byte;
begin
p := PByte(buff);
idx := 0;
bytecount := (bitcount - 1) div 8 + 1;
for i := 0 to bytecount - 1 do
begin
b := p^;
for k := 0 to 7 do
begin
bits[idx] := (b and BitTable[k]) > 0;
inc(idx);
if idx >= bitcount then
Break;
end;
inc(p);
end;
end;
procedure bufftobits2(buff: Pointer; bitcount: integer; var bits: array of boolean);
var
i, idx, k: Integer;
bytecount: Integer;
p: PByte;
b: Byte;
begin
p := PByte(buff);
idx := 0;
bytecount := (bitcount - 1) div 8 + 1;
for i := 0 to bytecount - 1 do
begin
b := p^;
for k := 7 downto 0 do
begin
bits[idx] := (b and BitTable[k]) > 0;
inc(idx);
if idx >= bitcount then
Break;
end;
inc(p);
end;
end;
procedure bitstobuff(buff: Pointer; bitcount: integer; bits: array of boolean);
var
i, idx, k: Integer;
bytecount: Integer;
p: PByte;
b: Byte;
begin
p := PByte(buff);
idx := 0;
bytecount := (bitcount - 1) div 8 + 1;
for i := 0 to bytecount - 1 do
begin
//b := p^;
b := 0;
for k := 0 to 7 do
begin
if bits[idx] then
begin
b := b or BitTable[k]
end
else
begin
b := b and BitTable_no[k];
end;
inc(idx);
if idx >= bitcount then
Break;
end;
p^ := b;
inc(p);
end;
end;
function t1200_to_t2400(fn1, fn2: string): boolean;
begin
Result := EpToEP(YKDefine_t_1200, fn1, YKDefine_t_2400, fn2);
end;
function t1200_to_z1200(fn1, fn2: string): boolean;
begin
Result := EpToEP(YKDefine_t_1200, fn1, YKDefine_z_1200, fn2);
end;
function t1200_to_z2400(fn1, fn2: string): boolean;
begin
Result := EpToEP(YKDefine_t_1200, fn1, YKDefine_z_2400, fn2);
end;
function ep_to_ep(ms: TMemoryStream; fn: string; width_to: integer; CopyBitRecList: array of CopyBitRec): boolean;
var
ms_to: TMemoryStream;
DataPos, y: Integer;
bits_from: array of Boolean;
LinePos_from, LineByteCount_from: Integer;
w_from, h_from: Word;
LinePos_to, LineByteCount_to: Integer;
w_to, h_to: Word;
bits_to: array of Boolean;
p: PByte;
i: integer;
function copyBit(from_begin, from_end, to_begin: integer): integer;
var
i_from, i_to: integer;
begin
i_to := to_begin;
for i_from := from_begin to from_end do
begin
bits_to[i_to] := bits_from[i_from];
inc(i_to);
end;
Result := i_to;
end;
procedure set_wh_to;
var
i, maxw, w: integer;
begin
if width_to > 0 then
w_to := width_to
else
begin
maxw := 0;
for i := 0 to high(CopyBitRecList) do
with CopyBitRecList[i] do
begin
w := to_begin + (from_end - from_begin);
if w > maxw then
maxw := w;
end;
w_to := maxw + 1;
end;
h_to := h_from;
end;
procedure set_bit;
var
i: integer;
begin
for i := 0 to high(CopyBitRecList) do
with CopyBitRecList[i] do
copyBit(from_begin, from_end, to_begin);
end;
begin
Result := false;
ms_to := TMemoryStream.Create;
try
w_from := ep_width(ms);
h_from := ep_height(ms);
DataPos := ep_DataPos(ms);
setlength(bits_from, w_from);
LineByteCount_from := getByteCount(w_from);
set_wh_to;
setlength(bits_to, w_to);
LineByteCount_to := getByteCount(w_to);
ms_to.Size := DataPos + LineByteCount_to * h_to;
ms.Seek(0, soBeginning);
ms.Position := 0;
ms_to.CopyFrom(ms, DataPos); //复制头
for y := 1 to h_from do
begin
LinePos_from := DataPos + (y - 1) * LineByteCount_from;
ms.Position := 0;
p := ms.Memory;
inc(p, LinePos_from);
bufftobits(p, w_from, bits_from);
///
for i := 0 to high(bits_to) do
begin
bits_to[i] := false; //i=0;// false;
end;
set_bit;
///
LinePos_to := DataPos + (y - 1) * LineByteCount_to;
ms_to.Position := 0;
p := ms_to.Memory;
inc(p, LinePos_to);
FillChar(p^, LineByteCount_to, 0);
bitstobuff(p, w_to, bits_to);
end;
ep_width_set(ms_to, w_to);
ms_to.SaveToFile(fn);
Result := true;
except
end;
setlength(bits_from, 0);
setlength(bits_to, 0);
FreeAndNil(ms_to);
end;
function checkbody_count(fn: string; YKDefine: TYKDefine): integer;
var
ms_ep, ms_to: TMemoryStream;
DataPos, y, x: Integer;
w_from, h_from: Word;
LinePos_from, LineByteCount_from: Integer;
bits_from: array of Boolean;
p: PByte;
i: integer;
p_to: PByte;
idx_to: integer;
w_to, h_to: Word;
count, count_no_same: integer;
w_per: integer;
p_per_1, p_per_2: PByte;
byte_size_per: integer;
begin
Result := 0;
if not FileExists(fn) then
exit;
if YKDefine.YkDrawingStart <= 0 then
exit;
if YKDefine.YkDrawingEnd <= 0 then
exit;
if YKDefine.YkDrawingEnd < YKDefine.YkDrawingStart then
exit;
ms_ep := TMemoryStream.Create;
ms_to := TMemoryStream.Create;
try
ms_ep.LoadFromFile(fn);
w_from := ep_width(ms_ep);
h_from := ep_height(ms_ep);
DataPos := ep_DataPos(ms_ep);
if h_from <= 0 then
Abort;
if w_from <= 0 then
Abort;
w_to := h_from;
h_to := (YKDefine.YkDrawingEnd - YKDefine.YkDrawingStart + 1);
ms_to.Size := h_to * w_to;
setlength(bits_from, w_from);
LineByteCount_from := getByteCount(w_from);
for y := 1 to h_from do
begin
LinePos_from := DataPos + (y - 1) * LineByteCount_from;
ms_ep.Position := 0;
p := ms_ep.Memory;
inc(p, LinePos_from);
bufftobits(p, w_from, bits_from);
for x := YKDefine.YkDrawingStart to YKDefine.YkDrawingEnd do
begin
idx_to := (y - 1) + (x - YKDefine.YkDrawingStart) * w_to; //行列互换
ms_to.Position := 0;
p_to := ms_to.Memory;
inc(p_to, idx_to);
p_to^ := byte(bits_from[x - 1]);
end;
end;
for count := h_to downto 2 do
begin
if h_to mod count > 0 then //不能整除
Continue;
w_per := h_to div count;
count_no_same := 0;
byte_size_per := w_per * w_to;
ms_to.Position := 0;
p_per_1 := ms_to.Memory; //第一块
p_per_2 := p_per_1;
inc(p_per_2, byte_size_per); //第二块
for i := 1 to count - 1 do
begin
if not CompareMem(p_per_1, p_per_2, byte_size_per) then
begin
inc(count_no_same);
{
if count = 4 then
begin
ms_ep.Clear;
ms_ep.Write(p_per_2^, byte_size_per);
ms_ep.SaveToFile('c:\' + inttostr(i) + '_2.dat');
ms_to.Size := byte_size_per;
ms_to.SaveTofile('c:\' + inttostr(i) + '_1.dat');
end; }
Break;
end;
p_per_1 := p_per_2;
inc(p_per_2, byte_size_per);
end;
if count_no_same = 0 then
begin
Result := count;
Break;
end;
end;
except
Result := 0;
end;
setlength(bits_from, 0);
FreeAndNil(ms_ep);
FreeAndNil(ms_to);
end;
function checkbody_width(fn: string; YKDefine: TYKDefine): integer;
var
c: integer;
begin
c := checkbody_count(fn, YKDefine);
Result := (YKDefine.YkDrawingEnd - YKDefine.YkDrawingStart + 1) div c;
end;
function EpToBmp(fn_ep, fn_bmp: string): Boolean;
var
bmp: TBitmap;
begin
Result := false;
bmp := TBitmap.Create;
try
if EpToBmp_bmp(fn_ep, bmp) then
begin
bmp.SaveToFile(fn_bmp);
Result := true;
end;
except
end;
FreeAndNil(bmp);
end;
function EpToBmp_bmp(fn: string; bmp: TBitmap): Boolean;
var
ms: TMemoryStream;
begin
Result := false;
if not FileExists(fn) then
exit;
ms := TMemoryStream.Create;
try
ms.LoadFromFile(fn);
Result := EpToBmp_ms(ms, bmp);
except
end;
FreeAndNil(ms);
end;
function EpToBmp_ms(ms: TMemoryStream; bmp: TBitmap): Boolean;
var
w, h, DataPos: Word;
y, LinePos, k: integer;
LineByteCount: integer;
p: PByte;
bmpline: Pointer;
linebuff: PByte;
lineP: PByte;
begin
Result := false;
try
w := ep_width(ms);
h := ep_height(ms);
DataPos := ep_DataPos(ms);
bmp.PixelFormat := pf1bit;
bmp.Width := w;
bmp.Height := h;
LineByteCount := getByteCount(w);
linebuff := GetMemory(LineByteCount);
for y := 1 to h do
begin
LinePos := DataPos + (y - 1) * LineByteCount;
ms.Position := 0;
p := ms.Memory;
inc(p, LinePos);
lineP := linebuff;
for k := 0 to LineByteCount - 1 do
begin
lineP^ := BitTable_down[p^];
inc(p);
inc(lineP);
end;
bmpline := bmp.ScanLine[y - 1];
Move(linebuff^, bmpline^, LineByteCount);
end;
Result := true;
except
end;
FreeMemory(linebuff);
end;
function EpToEP(SourceYK: TYKDefine; SourceEP: string;
TargeYK: TYKDefine; TargeEP: string): Boolean;
var
tmprec: array of CopyBitRec;
i: integer;
ms: TMemoryStream;
body_count: integer;
body_with: integer;
begin
Result := false;
if not FileExists(SourceEP) then
Exit;
body_count := checkbody_count(SourceEP, SourceYK);
body_with := (SourceYK.YkDrawingEnd - SourceYK.YkDrawingStart + 1) div body_count;
if (TargeYK.YkDrawingEnd - TargeYK.YkDrawingStart + 1) mod body_with <> 0 then
begin
raise Exception.Create('不能转换，原因：目标格式的正文宽度(' + IntToStr(TargeYK.YkDrawingEnd - TargeYK.YkDrawingStart + 1) + ')不是原文件的最小图宽(' + IntToStr(body_with) + ')的倍数.');
end;
///
setlength(tmprec, 255);
ms := TMemoryStream.Create;
try
i := YKDefine2CopyBitRec(SourceYK, TargeYK, tmprec);
setlength(tmprec, i);
ms.LoadFromFile(SourceEP);
Result := ep_to_ep(ms, TargeEP, TargeYK.YKTotalWidth, tmprec);
except;
end;
FreeAndNil(ms);
setlength(tmprec, 0);
end;
initialization
initBitTable;
inittest;
finalization
cleartest;
end.
显示部分的全部代码
unit U_viewep;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, Buttons;
const
wm_redraw_bmp = wm_user + 101;
type
TFrame_viewep = class(TFrame)
Panel1: TPanel;
Panel_bmp: TPanel;
ScrollBar_width: TScrollBar;
Panel3: TPanel;
ScrollBar_height: TScrollBar;
Panel4: TPanel;
PaintBox_bmp: TPaintBox;
Panel5: TPanel;
PaintBox_top: TPaintBox;
PaintBox_left: TPaintBox;
ComboBox_view: TComboBox;
Label1: TLabel;
Label_xy: TLabel;
Label_color: TLabel;
Label_info: TLabel;
SpeedButton1: TSpeedButton;
OpenDialog1: TOpenDialog;
procedure PaintBox_bmpPaint(Sender: TObject);
procedure PaintBox_leftPaint(Sender: TObject);
procedure PaintBox_topPaint(Sender: TObject);
procedure ComboBox_viewChange(Sender: TObject);
procedure ScrollBar_widthChange(Sender: TObject);
procedure ScrollBar_heightChange(Sender: TObject);
procedure PaintBox_bmpMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure PaintBox_bmpMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure PaintBox_bmpMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure SpeedButton1Click(Sender: TObject);
private
{ Private declarations }
Bmp: TBitmap;
buff_bmp: TBitmap;
Ffilename: string;
downX, downY: integer;
down_widthPosition, down_heightPosition: integer;
otherView: array of TFrame_viewep;
procedure display;
function getzoom: Double;
procedure redraw_bmp(var Message: TWMSize); message wm_redraw_bmp;
procedure text90(ACanvas: TCanvas; x, y: integer; text: string);
function getsrcrect(var rect: TRect): TRect;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure setScrollBar;
procedure loadfile(fn: string);
procedure setzoomxy(zoom: string; x, y: integer);
procedure displayotherView;
procedure clearotherView;
procedure addotherView(View: TFrame_viewep);
property filename: string read Ffilename;
property Bmp_ep: TBitmap read Bmp;
end;
implementation
uses math, U_epfile_function, Types;
const
toplett_color = $FFFBF0;
{$R *.dfm}
{ TFrame_viewep }
constructor TFrame_viewep.Create(AOwner: TComponent);
begin
Bmp := TBitmap.Create;
buff_bmp := TBitmap.Create;
inherited;
Label_xy.Caption := '';
Label_color.Caption := '';
Label_info.Caption := '';
downX := -1;
downY := -1;
PaintBox_bmp.Parent.DoubleBuffered := true;
end;
destructor TFrame_viewep.Destroy;
begin
clearotherView;
FreeAndNil(bmp);
FreeAndNil(buff_bmp);
inherited;
end;
procedure TFrame_viewep.display;
begin
ScrollBar_height.OnChange := nil;
ScrollBar_width.OnChange := nil;
ComboBox_view.OnChange := nil;
setScrollBar;
ScrollBar_width.Position := 0;
ScrollBar_height.Position := 0;
ComboBox_view.ItemIndex := ComboBox_view.Items.IndexOf('100%');
Panel_bmp.Repaint;
ScrollBar_height.OnChange := ScrollBar_heightChange;
ScrollBar_width.OnChange := ScrollBar_widthChange;
ComboBox_view.OnChange := ComboBox_viewChange;
Label_info.Caption := ExtractFileName(filename) + Format(' (%d,%d)', [Bmp.Width, bmp.Height]);
end;
procedure TFrame_viewep.loadfile(fn: string);
begin
if not FileExists(fn) then
exit;
if SameText('.bmp', ExtractFileExt(fn)) then
Bmp.LoadFromFile(fn)
else
begin
if SameText('.ep', ExtractFileExt(fn)) then
begin
EpToBmp_bmp(fn, bmp);
end
else
begin
exit;
end;
end;
Ffilename := fn;
display;
end;
procedure TFrame_viewep.PaintBox_bmpPaint(Sender: TObject);
var
pb: TPaintBox;
rect, rect_src: TRect;
aCanvas: TCanvas;
begin
pb := TPaintBox(Sender);
if (pb.Width <> buff_bmp.Width) or (pb.Height <> buff_bmp.Height) then
begin
buff_bmp.Width := pb.Width;
buff_bmp.Height := pb.Height;
end;
rect := classes.Rect(0, 0, pb.width, pb.height);
aCanvas := buff_bmp.Canvas;
aCanvas.Brush.Color := clBlack;
aCanvas.FillRect(rect);
if Bmp.Width <= 0 then
begin
;
end
else
begin
rect_src := getsrcrect(rect);
aCanvas.CopyRect(Rect, bmp.Canvas, rect_src);
end;
pb.Canvas.Draw(0, 0, buff_bmp);
end;
procedure TFrame_viewep.PaintBox_leftPaint(Sender: TObject);
var
pb: TPaintBox;
rect, rect_src: TRect;
aCanvas: TCanvas;
y, y_i, inc_y: Integer;
i: integer;
textRect: TRect;
s: string;
y_f, zoom: Double;
begin
pb := TPaintBox(Sender);
rect := classes.Rect(0, 0, pb.width, pb.height);
aCanvas := pb.Canvas;
aCanvas.Brush.Color := toplett_color;
aCanvas.FillRect(rect);
if Bmp.Height <= 0 then
begin
exit;
end;
aCanvas.Pen.Color := clBlack;
y := 0;
aCanvas.MoveTo(PaintBox_bmp.Left - 4, y);
aCanvas.LineTo(PaintBox_bmp.Left - 4, pb.Height);
y := 0;
zoom := getzoom;
rect_src := getsrcrect(rect);
y_i := rect_src.Top;
y_f := y - 1;
inc_y := 1;
while y < pb.Height do
begin
aCanvas.MoveTo(PaintBox_bmp.Left - 4, y);
if (y_i mod 100 = 0) then
begin
if y_i > 0 then
aCanvas.LineTo(PaintBox_bmp.left - 10, y);
s := IntToStr(y_i);
text90(aCanvas, 1, y - aCanvas.TextWidth(s) div 2, s);
end
else
if y_i mod 50 = 0 then
begin
aCanvas.LineTo(PaintBox_bmp.left - 8, y);
s := IntToStr(y_i);
text90(aCanvas, 3, y - aCanvas.TextWidth(s) div 2, s);
end
else
if y_i mod 10 = 0 then
begin
aCanvas.LineTo(PaintBox_bmp.left - 6, y);
if zoom > 1.9999 then
begin
s := IntToStr(y_i);
text90(aCanvas, 5, y - aCanvas.TextWidth(s) div 2, s);
end;
inc_y := 10;
end;
y_f := y_f + inc_y * zoom;
y := round(y_f);
inc(y_i, inc_y);
end;
end;
procedure TFrame_viewep.PaintBox_topPaint(Sender: TObject);
var
pb: TPaintBox;
rect, rect_src: TRect;
aCanvas: TCanvas;
x, x_i, inc_x, x_p, y_p, line_len: Integer;
i: integer;
textRect: TRect;
s: string;
x_f, zoom: Double;
begin
pb := TPaintBox(Sender);
rect := classes.Rect(0, 0, pb.width, pb.height);
aCanvas := pb.Canvas;
aCanvas.Brush.Color := toplett_color;
aCanvas.FillRect(rect);
if Bmp.Width <= 0 then
begin
exit;
end;
aCanvas.Pen.Color := clBlack;
x := PaintBox_bmp.Left;
aCanvas.MoveTo(x, PaintBox_bmp.top - 4);
aCanvas.LineTo(pb.width, PaintBox_bmp.top - 4);
zoom := getzoom;
rect_src := getsrcrect(rect);
x_i := rect_src.Left;
x_f := x - 1;
inc_x := 1;
while x < pb.width do
begin
line_len := 0;
if x_i mod 100 = 0 then
begin
line_len := 10;
textRect := classes.Rect(x - 50, 0, x + 50, PaintBox_bmp.top - line_len);
DrawText(aCanvas.Handle, pchar(IntToStr(x_i)), -1, textRect, DT_CENTER);
end
else
if x_i mod 50 = 0 then
begin
line_len := 8;
textRect := classes.Rect(x - 50, 2, x + 50, PaintBox_bmp.top - line_len);
DrawText(aCanvas.Handle, pchar(IntToStr(x_i)), -1, textRect, DT_CENTER);
end
else
if x_i mod 10 = 0 then
begin
line_len := 6;
inc_x := 10;
if x - x_p > aCanvas.TextWidth(IntToStr(x_i)) then
begin
textRect := classes.Rect(x - 50, 4, x + 50, PaintBox_bmp.top - line_len);
DrawText(aCanvas.Handle, pchar(IntToStr(x_i)), -1, textRect, DT_CENTER);
end;
end;
if line_len > 0 then
begin
x_p := x - 1;
y_p := PaintBox_bmp.top;
aCanvas.MoveTo(x_p, y_p - 4);
aCanvas.LineTo(x_p, y_p - line_len);
end;
x_f := x_f + inc_x * zoom;
x := round(x_f);
inc(x_i, inc_x);
end;
//
if ScrollBar_height.Position = 0 then
begin
aCanvas.MoveTo(PaintBox_bmp.Left - 4, pb.Height - 1);
aCanvas.LineTo(PaintBox_bmp.left - 10, pb.Height - 1);
s := IntToStr(0);
text90(aCanvas, 1, pb.Height - 1 - aCanvas.TextWidth(s) div 2, s);
end;
end;
procedure TFrame_viewep.setScrollBar;
var
h, w: Integer;
zoom: Double;
begin
zoom := getzoom;
h := round(bmp.Height * zoom + 1);
w := round(bmp.Width * zoom + 1);
//
if h <= PaintBox_bmp.Height then
ScrollBar_height.Enabled := false
else
begin
ScrollBar_height.max := h - PaintBox_bmp.Height + 1;
ScrollBar_height.Visible := true;
end;
if w <= PaintBox_bmp.Width then
ScrollBar_width.Enabled := false
else
begin
ScrollBar_width.max := w - PaintBox_bmp.Width + 1;
ScrollBar_width.Enabled := true;
end;
end;
procedure TFrame_viewep.ComboBox_viewChange(Sender: TObject);
begin
//
setScrollBar;
PostMessage(Handle, wm_redraw_bmp, 0, 0);
end;
procedure TFrame_viewep.ScrollBar_widthChange(Sender: TObject);
begin
//
PostMessage(Handle, wm_redraw_bmp, 0, 0);
end;
procedure TFrame_viewep.ScrollBar_heightChange(Sender: TObject);
begin
//
PostMessage(Handle, wm_redraw_bmp, 0, 0);
end;
function TFrame_viewep.getzoom: Double;
var
s: string;
begin
Result := 1;
s := ComboBox_view.Text;
s := StringReplace(s, '%', '', [rfReplaceAll]);
s := StringReplace(s, ' ', '', [rfReplaceAll]);
Result := StrToInt(s) / 100;
end;
procedure TFrame_viewep.redraw_bmp(var Message: TWMSize);
begin
Panel_bmp.Invalidate;
displayotherView;
end;
procedure TFrame_viewep.PaintBox_bmpMouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
var
pb: TPaintBox;
rect, rect_src: TRect;
c: TColor;
s: string;
aX, aY: Integer;
zoom: Double;
begin
//
if (downX > 0) and (downX > 0) then
begin
PaintBox_bmp.OnMouseMove := nil;
ax := x - downX;
ay := y - downY;
ScrollBar_width.OnChange := nil;
ScrollBar_height.OnChange := nil;
ScrollBar_width.Position := down_widthPosition - aX;
ScrollBar_height.Position := down_heightPosition - aY;
Panel_bmp.Repaint;
displayotherView;
ScrollBar_height.OnChange := ScrollBar_heightChange;
ScrollBar_width.OnChange := ScrollBar_widthChange;
PaintBox_bmp.OnMouseMove := PaintBox_bmpMouseMove;
end;
///
pb := TPaintBox(Sender);
rect := classes.Rect(0, 0, pb.width, pb.height);
rect_src := getsrcrect(rect);
zoom := getzoom;
if (zoom > 0.9999) and ((rect.Right - rect.Left) > 0) and ((rect.Bottom - rect.top) > 0) then
begin
///
ax := 1 + rect_src.Left + x * (rect_src.Right - rect_src.Left) div (rect.Right - rect.Left);
ay := 1 + rect_src.top + y * (rect_src.Bottom - rect_src.top) div (rect.Bottom - rect.top);
Label_xy.Caption := Format('坐标:%d,%d ', [ax, ay, x, y]);
end
else
begin
Label_xy.Caption := '';
end;
c := TPaintBox(Sender).Canvas.Pixels[x, y];
if c > 0 then
begin
if c = clWhite then
s := '1'
else
s := '?';
end
else
s := '0';
Label_color.Caption := Format('颜色:%s', [s]);
end;
procedure TFrame_viewep.text90(ACanvas: TCanvas; x, y: integer; text: string);
var
bmp1, bmp2: TBitmap;
tw, th: Integer;
ax, ay: integer;
c: TColor;
begin
bmp1 := TBitmap.Create();
bmp2 := TBitmap.Create();
tw := ACanvas.TextWidth(Text);
th := ACanvas.TextHeight(Text);
bmp1.Width := tw;
bmp1.Height := th;
bmp2.Width := th;
bmp2.Height := tw;
bmp2.Canvas.Brush.Color := $FFFFFF;
bmp2.TransparentColor := $FFFFFF;
bmp2.Transparent := true;
bmp2.Canvas.FillRect(Rect(0, 0, th, tw));
bmp1.Canvas.Font.Assign(ACanvas.Font);
bmp1.Canvas.Brush.Color := $FFFFFF;
bmp1.Canvas.TextOut(0, 0, text);
for ax := 0 to tw - 1 do
for ay := 0 to th - 1 do
begin
c := bmp1.Canvas.Pixels[ax, ay];
if c <> $FFFFFF then
begin
bmp2.Canvas.Pixels[ay, tw - 1 - ax] := c;
end;
end;
ACanvas.Draw(x, y, bmp2);
FreeAndNil(bmp1);
FreeAndNil(bmp2);
end;
procedure TFrame_viewep.PaintBox_bmpMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if bmp.Width <= 0 then
exit;
Screen.Cursor := crHandPoint;
downX := x;
downY := y;
down_widthPosition := ScrollBar_width.Position;
down_heightPosition := ScrollBar_height.Position;
end;
procedure TFrame_viewep.PaintBox_bmpMouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if bmp.Width <= 0 then
exit;
Screen.Cursor := crDefault;
downX := -1;
downY := -1;
end;
procedure TFrame_viewep.SpeedButton1Click(Sender: TObject);
begin
if OpenDialog1.Execute then
loadfile(OpenDialog1.FileName);
end;
function TFrame_viewep.getsrcrect(var rect: TRect): TRect;
var
zoom: Double;
x, y, x2, y2, w, h: integer;
begin
zoom := getzoom;
x := ScrollBar_width.Position;
y := ScrollBar_height.Position;
x2 := x + PaintBox_bmp.Width;
y2 := y + PaintBox_bmp.Height;
h := round(bmp.Height * zoom);
w := round(bmp.Width * zoom);
x2 := min(x2, w);
y2 := Min(y2, h);
rect := classes.Rect(0, 0, x2 - x, y2 - y);
x := round(x / zoom);
y := round(y / zoom);
x2 := round(x2 / zoom);
y2 := round(y2 / zoom);
x := max(0, x);
y := max(0, y);
x2 := min(bmp.Width, x2);
y2 := min(bmp.Height, y2);
Result := classes.Rect(x, y, x2, y2);
if zoom > 0.9999 then
begin
rect.Right := rect.Left + round(zoom * (Result.Right - Result.Left));
rect.Bottom := rect.top + round(zoom * (Result.Bottom - Result.top));
end;
end;
procedure TFrame_viewep.setzoomxy(zoom: string; x, y: integer);
var
idx: Integer;
begin
ScrollBar_height.OnChange := nil;
ScrollBar_width.OnChange := nil;
ComboBox_view.OnChange := nil;
idx := ComboBox_view.Items.IndexOf(zoom);
if idx >= 0 then
ComboBox_view.ItemIndex := idx;
setScrollBar;
ScrollBar_width.Position := x;
ScrollBar_height.Position := y;
Panel_bmp.Invalidate;
ScrollBar_height.OnChange := ScrollBar_heightChange;
ScrollBar_width.OnChange := ScrollBar_widthChange;
ComboBox_view.OnChange := ComboBox_viewChange;
end;
procedure TFrame_viewep.clearotherView;
begin
SetLength(otherView, 0);
end;
procedure TFrame_viewep.addotherView(View: TFrame_viewep);
var
i: integer;
begin
i := length(otherView);
SetLength(otherView, i + 1);
otherView[i] := View;
end;
procedure TFrame_viewep.displayotherView;
var
i, x, y: integer;
zoom: string;
begin
zoom := ComboBox_view.Text;
x := ScrollBar_width.Position;
y := ScrollBar_height.Position;
for i := 0 to High(otherView) do
begin
otherView[i].setzoomxy(zoom, x, y);
end;
end;
end.